Antecedentes
source('code/antecedentes.R')
## `summarise()` has grouped output by 'edad'. You can override using the
## `.groups` argument.
## New names:
Variacion Interanual
Tasa básica pasiva
### Poblaciones #### Tasas de mortalidad
Esperanzas al nacer
Empleados de la empresa ABC
Primer ejercicio
Punto A
tablas_activos <- proyeccion_demografica_activos(base_empleados, tablas_supen)
llamamos es script con los gráficos.
source('code/graficos_activos.R')
fig_activos_vivos
Punto B
Punto C
fig_activos_muertos
Punto D
Punto E
Para esta sección, se toman las proyecciones demográficas ya hechas anteriormente.
En primer lugar, creamos las tablas en cuestión que nos ayudarán a graficar.
tablas_proy_fin <- proyeccion_financiera(tablas_activos, inflacion = 0.03)
Punto F
Punto G
Punto H
Estas son las primas para cada empleado tasa tomando en cuenta la inflación por medio de la ecuación de Fisher (1+i) = (1+tasa_real)(1+inflación), en este caso 0.0712 utilizando 0.04 tasa real y 0.03 de la inflación.
#Primas para empleados
Primas<-Calcula_prima_individuales(base_empleados,tablas_supen,5000000,1000000,300000,0.04)
#Base de empleados de combinaciones únicas
base_unicas<- unico(base_empleados)
#Primas para empleados, Hombre o Mujer y su respectiva edad
Primas_unicas <- Calcula_prima_individuales(base_unicas,tablas_supen,5000000,1000000,300000,0.04)
Primas_unicas <- Primas_unicas%>%
mutate(Sexo = if_else(Sexo == 1,'Hombre', 'Mujer')) %>%
select(-c(`Empleado`,`anualidad`,`beneficios`))
tabla_latex_primas_unicas <- xtable(Primas_unicas)
print(tabla_latex_primas_unicas)
## % latex table generated in R 4.3.1 by xtable 1.8-4 package
## % Fri Jun 28 11:19:31 2024
## \begin{table}[ht]
## \centering
## \begin{tabular}{rlrr}
## \hline
## & Sexo & Edad & Primas \\
## \hline
## 1 & Hombre & 20.00 & 439746.01 \\
## 2 & Hombre & 21.00 & 460165.70 \\
## 3 & Hombre & 22.00 & 481722.66 \\
## 4 & Hombre & 23.00 & 504503.70 \\
## 5 & Hombre & 24.00 & 528604.14 \\
## 6 & Hombre & 25.00 & 554129.76 \\
## 7 & Hombre & 26.00 & 581194.49 \\
## 8 & Hombre & 27.00 & 609924.77 \\
## 9 & Hombre & 28.00 & 640459.67 \\
## 10 & Hombre & 29.00 & 672952.45 \\
## 11 & Hombre & 30.00 & 707572.59 \\
## 12 & Hombre & 31.00 & 744512.41 \\
## 13 & Hombre & 32.00 & 783989.37 \\
## 14 & Hombre & 33.00 & 826247.54 \\
## 15 & Hombre & 34.00 & 871563.22 \\
## 16 & Hombre & 35.00 & 920250.24 \\
## 17 & Hombre & 36.00 & 972667.07 \\
## 18 & Hombre & 37.00 & 1029221.23 \\
## 19 & Hombre & 38.00 & 1090378.22 \\
## 20 & Hombre & 39.00 & 1156675.52 \\
## 21 & Hombre & 40.00 & 1228737.32 \\
## 22 & Hombre & 41.00 & 1307292.57 \\
## 23 & Hombre & 42.00 & 1393194.79 \\
## 24 & Hombre & 43.00 & 1487455.02 \\
## 25 & Hombre & 44.00 & 1591280.06 \\
## 26 & Hombre & 45.00 & 1706128.66 \\
## 27 & Hombre & 46.00 & 1833768.18 \\
## 28 & Hombre & 47.00 & 1976355.93 \\
## 29 & Hombre & 48.00 & 2136550.43 \\
## 30 & Hombre & 49.00 & 2317675.08 \\
## 31 & Hombre & 50.00 & 2523944.61 \\
## 32 & Hombre & 51.00 & 2760777.85 \\
## 33 & Hombre & 52.00 & 3035262.32 \\
## 34 & Hombre & 53.00 & 3356850.75 \\
## 35 & Hombre & 54.00 & 3738455.91 \\
## 36 & Hombre & 55.00 & 4198172.22 \\
## 37 & Hombre & 56.00 & 4762137.09 \\
## 38 & Hombre & 57.00 & 5469570.35 \\
## 39 & Hombre & 58.00 & 6382114.54 \\
## 40 & Hombre & 59.00 & 7602507.85 \\
## 41 & Hombre & 60.00 & 9315658.31 \\
## 42 & Hombre & 61.00 & 11891327.80 \\
## 43 & Hombre & 62.00 & 16192301.42 \\
## 44 & Hombre & 63.00 & 24807020.34 \\
## 45 & Hombre & 64.00 & 50677961.59 \\
## 46 & Mujer & 20.00 & 496285.77 \\
## 47 & Mujer & 21.00 & 519408.02 \\
## 48 & Mujer & 22.00 & 543822.12 \\
## 49 & Mujer & 23.00 & 569623.77 \\
## 50 & Mujer & 24.00 & 596919.38 \\
## 51 & Mujer & 25.00 & 625824.01 \\
## 52 & Mujer & 26.00 & 656463.19 \\
## 53 & Mujer & 27.00 & 688974.23 \\
## 54 & Mujer & 28.00 & 723510.65 \\
## 55 & Mujer & 29.00 & 760245.36 \\
## 56 & Mujer & 30.00 & 799370.48 \\
## 57 & Mujer & 31.00 & 841099.99 \\
## 58 & Mujer & 32.00 & 885673.90 \\
## 59 & Mujer & 33.00 & 933360.07 \\
## 60 & Mujer & 34.00 & 984463.48 \\
## 61 & Mujer & 35.00 & 1039330.44 \\
## 62 & Mujer & 36.00 & 1098355.06 \\
## 63 & Mujer & 37.00 & 1161986.50 \\
## 64 & Mujer & 38.00 & 1230740.17 \\
## 65 & Mujer & 39.00 & 1305213.10 \\
## 66 & Mujer & 40.00 & 1386098.81 \\
## 67 & Mujer & 41.00 & 1474206.18 \\
## 68 & Mujer & 42.00 & 1570484.16 \\
## 69 & Mujer & 43.00 & 1676054.27 \\
## 70 & Mujer & 44.00 & 1792255.21 \\
## 71 & Mujer & 45.00 & 1920691.61 \\
## 72 & Mujer & 46.00 & 2063303.92 \\
## 73 & Mujer & 47.00 & 2222464.50 \\
## 74 & Mujer & 48.00 & 2401105.72 \\
## 75 & Mujer & 49.00 & 2602900.21 \\
## 76 & Mujer & 50.00 & 2832501.60 \\
## 77 & Mujer & 51.00 & 3095891.78 \\
## 78 & Mujer & 52.00 & 3400890.07 \\
## 79 & Mujer & 53.00 & 3757928.28 \\
## 80 & Mujer & 54.00 & 4181238.06 \\
## 81 & Mujer & 55.00 & 4690749.52 \\
## 82 & Mujer & 56.00 & 5315242.83 \\
## 83 & Mujer & 57.00 & 6097887.75 \\
## 84 & Mujer & 58.00 & 7106531.13 \\
## 85 & Mujer & 59.00 & 8454276.51 \\
## 86 & Mujer & 60.00 & 10344737.13 \\
## 87 & Mujer & 61.00 & 13185153.76 \\
## 88 & Mujer & 62.00 & 17925803.78 \\
## 89 & Mujer & 63.00 & 27417626.59 \\
## 90 & Mujer & 64.00 & 55915485.82 \\
## \hline
## \end{tabular}
## \end{table}
Punto I
Para la prima nivelada, se toman la suma de las esperanzas de los beneficios futuros y se divide por la suma de las esperanza del valor presente de las primas futuras, dando como resultado la prima nivelada anual.
## [1] 1228666
Punto J
Dado que la idea de este ejercicio es reducir las primas un 10%, calculo cuál es la suma que representa el 90% de las primas originales, para acercarnos a ellas.
#Calcula cuánto es el 90% de las primas obtenidas
Primas_90_porciento <- data.frame(Empleado = Primas$Empleado,
Menos_10_porciento = (Primas$Primas)*0.9)
La primera alternativa para reducir la prima 10%:
# Se calculan primas con:
# Suma asegurada de 5 millones durante el tiempo de ser empleado activo
# Suma asegurada de 5 millones durante pensión
# Primer año de pensión con mensualidad de 266.520 colones
Primas1_menos_10 <- Calcula_prima_individuales(base_empleados,tablas_supen,5000000,5000000,266520,0.04)
#se usa regla de 3 para verificar que la nueva prima sea aproximadamente el 90% de la original
Verifica1_90_porciento = data.frame(original_90 = Primas_90_porciento$Menos_10_porciento,
editada = Primas1_menos_10$Primas,
porcentaje= (Primas1_menos_10$Primas / Primas$Primas) * 100)
#Imprime el porcentaje promedio que representan las nuevas primas de las originales
print(sum(Verifica1_90_porciento$porcentaje)/nrow(Verifica1_90_porciento))
## [1] 90.08394
La Segunda alternativa para reducir la prima 10%:
# Se calculan primas con:
# Suma asegurada de 1 millón durante el tiempo de ser empleado activo
# Suma asegurada de 1 millón durante pensión
# Primer año de pensión con mensualidad de 271.900 colones
Primas2_menos_10 <- Calcula_prima_individuales(base_empleados,tablas_supen,1000000,1000000,271900,0.04)
#se usa regla de 3 para verificar que la nueva prima sea aproximadamente el 90% de la original
Verifica2_90_porciento = data.frame(original_90 = Primas_90_porciento$Menos_10_porciento,
editada = Primas2_menos_10$Primas,
porcentaje= (Primas2_menos_10$Primas / Primas$Primas) * 100)
#Imprime el porcentaje promedio que representan las nuevas primas de las originales
print(sum(Verifica2_90_porciento$porcentaje)/nrow(Verifica2_90_porciento))
## [1] 90.01209
#Primas para empleados, Hombre o Mujer y su respectiva edad
Primas_unicas_0.05 <- Calcula_prima_individuales(base_unicas,tablas_supen,5000000,1000000,300000,0.05)
Primas_unicas_0.05 <- Primas_unicas_0.05%>%
mutate(Sexo = if_else(Sexo == 1,'Hombre', 'Mujer')) %>%
select(-c(`Empleado`,`anualidad`,`beneficios`))
tabla_para_graficar_distinta_tasa <- data.frame( sexo = Primas_unicas$Sexo,
edad = Primas_unicas$Edad,
primas_normales = Primas_unicas$Primas,
primas_tasa_aumentada = Primas_unicas_0.05$Primas)
tabla_distinta_tasa_hombres <- tabla_para_graficar_distinta_tasa[tabla_para_graficar_distinta_tasa$sexo == "Hombre", ]
tabla_distinta_tasa_mujeres <- tabla_para_graficar_distinta_tasa[tabla_para_graficar_distinta_tasa$sexo == "Mujer", ]